perm filename WAVE.SAI[SYS,HE]4 blob
sn#084255 filedate 1974-01-29 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00026 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002 IFC NOMOVE THENC
C00006 00003 REQUIRE "HASH06.REL[SYS,HE]" LOAD_MODULE
C00011 00004 SIMPLE STRING PROCEDURE SIMIO(REFERENCE INTEGER BR)
C00012 00005 SIMPLE INTEGER PROCEDURE GETNAME(BOOLEAN NUMREFERENCE STRING SSTRING ARRAY NAME)
C00017 00006 STRING WAIT,LFILE,OFILE,SL
C00020 00007 REAL R
C00021 00008 SIMPLE PROCEDURE CONSTRUCT(SAFE REAL ARRAY T,E)
C00023 00009 FORMAT_POINTER←-1
C00025 00010 WAIT←"O.K."
C00032 00011 BEGIN "DOIT"
C00037 00012 BEGIN "BEGIN"
C00042 00013 BEGIN"FREE"
C00044 00014 BEGIN"OPEN_HAND"
C00046 00015 BEGIN"CHANGE"
C00049 00016 IF LENGTH(FILE) THEN FLUSH(0,LAST_ARM)
C00051 00017 BEGIN"LINK"
C00056 00018 BEGIN "DEFINE"
C00059 00019 BEGIN "DUMP"
C00063 00020 BEGIN"SET"
C00064 00021 BEGIN "EDIT"
C00068 00022 BEGIN "NNUL" SAY_WAITNO_NULL END"NNUL"
C00071 00023 BEGIN"MOVING"
C00074 00024 IFC GRAPHICS THENC
C00079 00025 SL←SIMIO(ONE_LINE)
C00084 00026 END ELSE
C00086 ENDMK
C⊗;
IFC NOMOVE THENC
DEFINE TSX="1.0017",TSY="1.0028";
DEFINE TYP_HAND="FALSE",DEB_HAND="FALSE";
FORWARD MESSAGE SIMPLE PROCEDURE START_TRAJECTORY(STRING FILE;INTEGER SFL);
INTERNAL INTEGER ARM_MOTION,ARM_STATUS,ARM_SEGMENT,ARM_WAIT,
ARM_TIME,ARM_EXECUTE;
INTERNAL BOOLEAN STOP_ON_TOUCH;
INTERNAL INTEGER ARRAY FELT[1:2,1:4,1:4];
REAL ARRAY ARM_LINK[3:6,1:4,1:4];
REAL GRASP;
INTERNAL SAFE REAL ARRAY ARM_VECTOR[1:7];
INTEGER ARM_PLAN;
SAFE REAL ARRAY FREE_ARM[0:6,1:6];
SAFE REAL ARRAY FORCE_ARM[1:6];
INTEGER GDISP_INIT;INTEGER ARRAY GDISP[0:14];
REQUIRE "INTFAC.REL[SYS,HE]" LOAD_MODULE;
ELSEC
REQUIRE "PREAMB.SAI[SYS,HE]" SOURCE_FILE;
REQUIRE "DRIVE.REL[SYS,HE]" LOAD_MODULE;
ENDC
EXTERNAL SIMPLE PROCEDURE ARMPOS;
EXTERNAL SIMPLE PROCEDURE HANDFN;
EXTERNAL SIMPLE PROCEDURE ARMFN(INTEGER NARGS);
EXTERNAL SIMPLE PROCEDURE ARMPROCEED(BOOLEAN REPEAT);
EXTERNAL SIMPLE PROCEDURE DOIT(INTEGER PPPN,BAND,FILE);
EXTERNAL SIMPLE PROCEDURE ARM_JOINT;
REAL ROTAT;
BOOLEAN INTERP;
SAFE REAL ARRAY TRANS[1:4,1:4];
INTERNAL SAFE INTEGER ARRAY ARM_MESSAGE[1:21];
INTEGER IFI,I,J,MESS;
BOOLEAN FRST_OPEN,AEF;
BOOLEAN TEST;
INTEGER N,CHAN;
REAL TX,TY,TZ;
INTEGER HAND;
STRING S,FILE;
INTEGER BREAK,EOF;
INTEGER NNUL,PTR2,PTR3,PTR4;
SAFE REAL ARRAY TH,DIR[1:6];
PRELOAD_WITH -180.0, -90.0, 12.0, -90.0, 90.0, 0.0;
SAFE REAL ARRAY V0[1:6];
LABEL EXETRUE,GGET,GET,GET1;
DEFINE TTY="1",ONE_LINE="1",HEAD="2",ID="3",DEL="4";
DEFINE OCTNUM="5",RSB="6",LN="7",SOME="10";
DEFINE NUMS="11",NNUMS="12",DOLLAR="13",SOMETHING="14";
DEFINE FF="15",SEMI="16",ALT_MODE="'175";
DEFINE FREE_DATA_LENGTH="100",MAX_STACK="150";
SAFE INTEGER ARRAY STACK[1:MAX_STACK];
SAFE INTEGER ARRAY COEFF[0:'1037];
REQUIRE "HASH06.REL[SYS,HE]" LOAD_MODULE;
EXTERNAL SIMPLE INTEGER PROCEDURE HASH(STRING S);
EXTERNAL SIMPLE INTEGER PROCEDURE REHASH;
STRING EDIT_NAME,LINE_NO,SPACES;
SAFE REAL ARRAY XT[1:4,1:4];
SAFE REAL ARRAY XV,YV,ZV[1:4];
DEFINE MAX_MACRO="20";
STRING ARRAY MACRO_FORMAL,MACRO_NAME,MACRO_SOURCE,MACRO_DEFN,FILE_NAME[1:MAX_MACRO];
SAFE INTEGER ARRAY MAC_TOP[0:MAX_MACRO-1];
INTEGER FMN,MAC_EOF,MAC,MAC_FREE;
DEFINE MAX_PAR="30";
SAFE STRING ARRAY MAC_PAR[1:MAX_PAR];
DEFINE MAX_LABELS="100";
STRING ARRAY LABEL_LINE,LABELS[1:MAX_LABELS];
INTEGER ARRAY BBEG,LLAB[0:15];
INTEGER FREEL;
INTEGER ARRAY PTRS[1:MAX_LABELS];
STRING ARRAY CODE_LINE,REF[1:MAX_STACK];
STRING ARRAY FUNNAM[0:'77];
INTEGER ARRAY FUNNUM[0:'77];
STRING ARRAY VECTNAM[0:'77];
STRING ARRAY TRANSNAM[0:'77];
INTEGER ARRAY TRANSNUM[0:'77];
INTEGER ARRAY VECTNUM[0:'77];
PRELOAD_WITH [3] 0, 1.0,[3] 0, 1.0, [3] 0, 1.0;
SAFE REAL ARRAY DATA_BASE[0:FREE_DATA_LENGTH,1:3];
INTEGER FREE_DATA;
SIMPLE STRING PROCEDURE ERRORS;
BEGIN
IF ARM_STATUS = 1 THEN RETURN("Arithmetic Overflow occured. Something bad has happened.");
IF ARM_STATUS LAND '7 = 1 THEN RETURN("Excessive force occured at joint "&CVS(ARM_STATUS LSH -3));
IF ARM_STATUS = 2 THEN RETURN("Hand closed more than minimum specified in CLOSE function");
IF ARM_STATUS = 3 THEN RETURN("File not found");
IF ARM_STATUS = 4 THEN RETURN("Someone has pawned the DSK");
IF ARM_STATUS = 5 THEN RETURN("Someone has sold the DSK");
IF ARM_STATUS LAND '7 = 6 THEN RETURN("Touch sensors "&CVOS(ARM_STATUS LSH -3)&" have touched something");
IF ARM_STATUS = 7 THEN RETURN("Cannot read the joint positions, usually hardware trouble.");
IF ARM_STATUS = '20 THEN RETURN("Function took too long to execute");
IF ARM_STATUS = '22 THEN RETURN("Hand function took too long to execute.");
IF ARM_STATUS = '23 THEN RETURN("Arm failed to reach force limit set by STOP during motion.");
IF ARM_STATUS = '24 THEN RETURN("Arm in L1: JUMP L1 type loop.");
IF ARM_STATUS = '25 THEN RETURN("Save array number out of bound");
IF ARM_STATUS = '27 THEN RETURN("The function you have called is disconnected.");
IF ARM_STATUS = '30 THEN RETURN("The arm is down");
IF ARM_STATUS = '50 THEN RETURN("Librascope read error");
IF ARM_STATUS = '60 THEN RETURN("You have a very old program which does not match the current servo");
IF ARM_STATUS = '70 THEN RETURN("The reference supply used by the arm is off.");
IF ARM_STATUS = '100 THEN RETURN("The PDP6 is not running.");
IF ARM_STATUS = '200 THEN RETURN("The servo program has been interrupted.");
IF ARM_STATUS = '300 THEN RETURN("The A/D is busy, mabye Colby is running");
IF ARM_STATUS = '400 THEN RETURN("The XGP is in use which upsets the arm");
IF ARM_STATUS = '500 THEN RETURN("Arm solution does not exist");
IF ARM_STATUS = '600 THEN RETURN("SOJG cell does not exist or there are too many");
RETURN("Unrecognized error state");
END;
SIMPLE STRING PROCEDURE SIMIO(REFERENCE INTEGER BR);
BEGIN STRING S;
IF MAC
THEN BEGIN S←SCAN(MACRO_SOURCE[MAC],BR,BREAK);
MAC_EOF←¬(LENGTH(MACRO_SOURCE[MAC]) ∨ LENGTH(S)) END
ELSE S←INPUT(CHAN,BR);
RETURN(S) END"SIMIO";
SIMPLE INTEGER PROCEDURE GETNAME(BOOLEAN NUM;REFERENCE STRING S;STRING ARRAY NAME);
BEGIN LABEL L1;
STRING SN;
INTEGER I;
L1: IF NUM THEN SIMIO(NUMS) ELSE SIMIO(HEAD);
IF MAC_EOF
THEN BEGIN
FOR I←LLAB[MAC] STEP 1 UNTIL FREEL
DO FOR J←BBEG[MAC] STEP 1 UNTIL PTR3+1
DO IF EQU(REF[J],LABELS[I])
THEN BEGIN
IF STACK[J] LAND '77000000 = '26000000 THEN BEGIN
N←PTRS[I]-J+COEFF[(STACK[J] LAND '777777) + 1];
REF[J]←NULL;
IF N+J<1 ∨ N+J>PTR3+1
THEN BEGIN
OUTSTR(CODE_LINE[J]&"JUMP OUT OF RANGE"&'15&'12);
N←PTR3+1-J END;
COEFF[(STACK[J] LAND '777777) +1]←N END ELSE
BEGIN
START_CODE
MOVE 1,STACK;
ADD 1,J;
HRRE 1,-1(1);
MOVEM 1,N END;
N←PTRS[I]-J+N;
REF[J]←NULL;
IF N+J<1 ∨ N+J>PTR3+1
THEN BEGIN
OUTSTR(CODE_LINE[J]&"JUMP OUT OF RANGE"&'15&'12);
N←PTR3+1-J END;
STACK[J]←(N LAND '777777) LOR (STACK[J] LAND '777000000) END;END;
FOR J←BBEG[MAC] STEP 1 UNTIL PTR3
DO IF LENGTH(REF[J])
THEN BEGIN OUTSTR(CODE_LINE[J]&REF[J]&" UNDEFINED"&'15&'12);
STACK[J]←(PTR3+1-J) LOR '102000000;
REF[J]←NULL;
LABEL_LINE[J]←NULL END;
MAC_FREE←MAC_TOP[MAC];
FREEL←LLAB[MAC]-1;
MAC←MAC-1;
MAC_EOF←0;
IF ¬MAC ∧ CHAN=1 THEN BEGIN LINE_NO←NULL;OUTSTR("*")END;
GO TO L1 END;
IF EOF THEN BEGIN RELEASE(CHAN);
CHAN←CHAN-1;
IF ¬MAC ∧ CHAN=1 THEN BEGIN LINE_NO←NULL;OUTSTR("*")END;
GO TO L1; END;
IF BREAK=-1
THEN BEGIN LINE_NO←SIMIO(LN);
GO TO L1 END;
IF BREAK=";" THEN BEGIN SIMIO(ONE_LINE); GO TO L1 END;
IF BREAK="$"
THEN BEGIN I←INTSCAN(S←SIMIO(NNUMS),J);
I←I+MAC_TOP[MAC];
IF I<1 ∨ I> MAC_FREE
THEN BEGIN OUTSTR(FILE_NAME[CHAN]&LINE_NO&"MACRO PARAMETER OUT OF RANGE"&'15&'12);
GO TO L1 END;
S←MAC_PAR[I] END
ELSE S←IF NUM THEN SIMIO(NNUMS) ELSE SIMIO(ID);
IF NUM THEN BEGIN
SN←SCAN(S,DOLLAR,J);
IF J="$" THEN BEGIN
I←INTSCAN(S,J);
I←I+MAC_TOP[MAC];
IF I<1 ∨ I> MAC_FREE
THEN BEGIN OUTSTR(FILE_NAME[CHAN]&LINE_NO&"MACRO PARAMETER OUT OF RANGE"&'15&'12);
GO TO L1 END;
S←SN&MAC_PAR[I] END ELSE S←SN;
RETURN(-1) END;
IF BREAK=":"
THEN BEGIN
FOR I←LLAB[MAC] STEP 1 UNTIL FREEL
DO IF EQU(S,LABELS[I])
THEN BEGIN OUTSTR(FILE_NAME[CHAN]&LINE_NO&S&" MULTIPLY DEFINED LABEL"&'15&'12);
GO TO L1 END;
LABELS[FREEL←FREEL+1]←S;
LABEL_LINE[FREEL]←FILE_NAME[CHAN]&LINE_NO;
PTRS[FREEL]←PTR3+1;
GO TO L1 END;
I←HASH(S);
WHILE LENGTH(NAME[I])
DO BEGIN IF EQU(S,NAME[I]) THEN DONE;
I←REHASH END;
RETURN(I) END;
STRING WAIT,LFILE,OFILE,SL;
SIMPLE PROCEDURE OPEN_ONE;
IF ¬(LENGTH(FILE) ∨ AEF) THEN START_TRAJECTORY ((LFILE←FILE←OFILE),0);
FORWARD SIMPLE PROCEDURE CONSTRUCT(SAFE REAL ARRAY T,E);
SIMPLE INTEGER PROCEDURE INTERN(STRING S;STRING ARRAY NAME);
BEGIN INTEGER I;
I←HASH(S);
WHILE LENGTH(NAME[I])
DO BEGIN IF EQU(S,NAME[I]) THEN RETURN(I);
I←REHASH END;
NAME[I]←S;
RETURN(I) END;
DEFINE SAY_WAIT="IF ¬MAC ∧ CHAN=1 THEN OUTSTR(WAIT&'15&'12)";
BOOLEAN SIMPLE PROCEDURE READT(REAL ARRAY T;REFERENCE STRING S;STRING MESS);
BEGIN INTEGER I;
SAFE OWN REAL ARRAY E[1:6];
I←GETNAME(FALSE,S,TRANSNAM);
IF LENGTH(TRANSNAM[I])
THEN BEGIN ARRBLT(E[1],DATA_BASE[TRANSNUM[I],1],6);
CONSTRUCT(T,E);
RETURN(TRUE) END;
OUTSTR(FILE_NAME[CHAN]&LINE_NO&MESS&'15&'12);
RETURN(FALSE) END;
BOOLEAN SIMPLE PROCEDURE READV(REAL ARRAY V;REFERENCE STRING S;STRING MESS);
BEGIN INTEGER I;
I←GETNAME(FALSE,S,VECTNAM);
IF LENGTH(VECTNAM[I])
THEN BEGIN ARRBLT(V[1],DATA_BASE[VECTNUM[I],1],3);
V[4]←1;
RETURN(TRUE) END;
OUTSTR(FILE_NAME[CHAN]&LINE_NO&MESS&'15&'12);
RETURN(FALSE) END;
SAFE REAL ARRAY TT1[1:4,1:4];
PRELOAD_WITH 20,30,1,180,90,0; SAFE REAL ARRAY ANEW[1:6];
IFC GRAPHICS THENC
REQUIRE"DPYSUB.HDR[SYS,HE]" SOURCE_FILE;
ENDC
STRING FUNCTION,S11,SM,DFILE;
PRELOAD_WITH 100.0, 100.0, 100.0, 100.0, 100.0, 100.0;
SAFE REAL ARRAY THFAC[1:6];
REAL R;
SAFE REAL ARRAY VT,VT1,VT2[1:4];
PRELOAD_WITH [2] 0.0, [2] 1.0;
SAFE REAL ARRAY UZ[1:4];
SAFE REAL ARRAY ST[1:6];
INTEGER NMASK,TIP,PAD,HIT,LL,UL,MODULUS,PTR,TIME,INDEX,BP;
REAL FACTOR;
PRELOAD_WITH 0;
SAFE INTEGER ARRAY BUFFER[0:100];
REQUIRE "TRAJ.SAI" SOURCE_FILE;
SIMPLE PROCEDURE CONSTRUCT(SAFE REAL ARRAY T,E);
BEGIN
REAL SI1,SI2,SI3,CO1,CO2,CO3;
T[1,4]←E[1]*TSX;
T[2,4]←E[2]*TSY;
T[3,4]←E[3];
SI1←SIND(E[4]);CO1←COSD(E[4]);
SI2←SIND(E[5]);CO2←COSD(E[5]);
SI3←SIND(E[6]);CO3←COSD(E[6]);
T[1,1]←-SI1*SI2*CO3+CO1*SI3;
T[1,2]← SI1*SI2*SI3+CO1*CO3;
T[2,1]← CO1*SI2*CO3+SI1*SI3;
T[2,2]←-CO1*SI2*SI3+SI1*CO3;
T[1,3]← SI1*CO2;
T[2,3]←-CO1*CO2;
T[3,1]←-CO2*CO3;
T[3,2]← CO2*SI3;
T[3,3]←-SI2;
T[4,1]←T[4,2]←T[4,3]←0;
T[4,4]←1;
END;
SIMPLE PROCEDURE UNSTRUCT(SAFE REAL ARRAY T,E);
BEGIN
REAL CO2;
E[1]←T[1,4]/TSX;
E[2]←T[2,4]/TSY;
E[3]←T[3,4];
E[5]←RAD*ATAN2(-T[3,3],CO2←SQRT(T[1,3]↑2+T[2,3]↑2));
IF CO2<0.01 THEN BEGIN
E[4]←RAD*ATAN2(T[2,2],T[1,2]);
E[6]←0;
RETURN END;
E[4]←RAD*ATAN2(T[1,3],-T[2,3]);
E[6]←RAD*ATAN2(T[3,2],-T[3,1])
END;
FORMAT_POINTER←-1;
INTERP←TRUE;
RESET_CONO;
AEF←ARM_EXECUTE←FALSE;
PUSH_FORMAT(10,4);
ARM_SEGMENT←0;
ARM_MOTION←0;
FAST←TRUE;
FOR I←0 STEP 1 UNTIL '37 DO BANDS[I]←NULL;
NEXT_BAND←0;
STOP_ON_TOUCH←FALSE;
FOR I←1 STEP 1 UNTIL 6 DO MMOVE(A[SQAR(I)],A[SQAR(I)]);
MMOVE(Q[0],Q[0]);
MMOVE(Q[17],Q[17]);
FOR I←1 STEP 1 UNTIL 3 DO DEPART_ARM[I]←ARRIVE_ARM[I]←IF I=3 THEN 3.0 ELSE 0.0;
DEPART_ARM[4]←ARRIVE_ARM[4]←1.0;
FOR I←1 STEP 1 UNTIL 6 DO BEGIN
N←SQAR(I);
MMOVE(JMAT[N],JMAT[N])END ;
HANDPOS(V0);
ARRBLT(PARK_TRANS[1,1],T[SQAR(6)],16);
DO BEGIN
ARM_POSITION;
IF ARM_STATUS THEN
IFC WAVE THENC
BEGIN OUTSTR(ERRORS&"
TYPE Y TO START FROM PARK ELSE CHECK PDP-6 AND TYPE C/R"&CRLF);
ELSEC
BEGIN OUTSTR(CVOS(ARM_STATUS)&"
TYPE Y TO START FROM PARK ELSE CHECK PDP-6 AND TYPE C/R"&CRLF);
ENDC
S←INCHWL;
IF S="Y" THEN BEGIN
ARRTRAN(ARM_VECTOR,V0);
ARM_VECTOR[7]←0;
UPDATE_SEG;
ARM_STATUS←0 END;
END;
END UNTIL ¬ARM_STATUS;
ARRTRAN(LAST_ARM,ARM_VECTOR);
WAIT←"O.K.";
SPACES←" ";
GDISP_INIT←0;
OPEN(TTY,"TTY",0,2,0,120,BREAK,EOF);
EDIT_NAME←LFILE←FILE←NULL;
WAS_FORCED←TRUE;
FREEL←0;
FOR I←0 STEP 1 UNTIL 15 DO LLAB[I]←1;
OFILE←"YELLOW";
SETBREAK(ONE_LINE,'12&ALT_MODE,'14&'15,"IN");
SETBREAK(SOME,"0123456789.@+-;$ABCDEFGHIJKLMNOPQRSTUVWXYZ",NULL,"ILRD");
SETBREAK(SOMETHING,"0123456789.@+-;$ABCDEFGHIJKLMNOPQRSTUVWXYZ"&'12,'15,"ILRD");
SETBREAK(HEAD,"$;ABCDEFGHIJKLMNOPQRSTUVWXYZ",NULL,"ILRD");
SETBREAK(ID,"ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_",NULL,"XN");
SETBREAK(RSB,"]",NULL,"IAN");
SETBREAK(DEL,"()[] ,;: ",NULL,"IN");
SETBREAK(NUMS,"0123456789.@+-$;",NULL,"ILR");
SETBREAK(NNUMS,"$0123456789.@+-",NULL,"XL");
SETBREAK(DOLLAR,"$",NULL,"I");
SETBREAK(LN," ",NULL,"IA");
SETBREAK(FF,'14,NULL,"I");
SETBREAK(SEMI,";",NULL,"IR");
NMASK←'777777774000;
CHAN←TTY;
FMN←MAC←MAC_EOF←EOF←MAC_FREE←0;
FUNNUM[INTERN("DO",FUNNAM)]←0;
FUNNUM[INTERN("REQUIRE",FUNNAM)]←1;
FUNNUM[INTERN("TRANS",FUNNAM)]←2;
FUNNUM[INTERN("VECT",FUNNAM)]←3;
FUNNUM[INTERN("BEGIN",FUNNAM)]←4;
FUNNUM[INTERN("PARK",FUNNAM)]←5;
FUNNUM[INTERN("MOVE",FUNNAM)]←6;
FUNNUM[INTERN("STEP",FUNNAM)]←7;
FUNNUM[INTERN("DRAW",FUNNAM)]←8;
FUNNUM[INTERN("FREE",FUNNAM)]←9;
FUNNUM[INTERN("SPIN",FUNNAM)]←10;
FUNNUM[INTERN("FORCE",FUNNAM)]←11;
FUNNUM[INTERN("STOP",FUNNAM)]←12;
FUNNUM[INTERN("OPEN",FUNNAM)]←13;
FUNNUM[INTERN("SKIPE",FUNNAM)]←14;
FUNNUM[INTERN("JUMP",FUNNAM)]←15;
FUNNUM[INTERN("CLOSE",FUNNAM)]←16;
FUNNUM[INTERN("CENTER",FUNNAM)]←17;
FUNNUM[INTERN("PLACE",FUNNAM)]←18;
FUNNUM[INTERN("CHANGE",FUNNAM)]←19;
FUNNUM[INTERN("DRIVE",FUNNAM)]←20;
FUNNUM[INTERN("WAIT",FUNNAM)]←21;
FUNNUM[INTERN("MERGE",FUNNAM)]←22;
FUNNUM[INTERN("SAVE",FUNNAM)]←23;
FUNNUM[INTERN("RESTORE",FUNNAM)]←24;
FUNNUM[INTERN("TOUCH",FUNNAM)]←25;
FUNNUM[INTERN("CONO",FUNNAM)]←26;
FUNNUM[INTERN("END",FUNNAM)]←27;
FUNNUM[INTERN("FLUSH",FUNNAM)]←28;
FUNNUM[INTERN("P",FUNNAM)]←29;
FUNNUM[INTERN("ASSERT",FUNNAM)]←30;
FUNNUM[INTERN("FILE",FUNNAM)]←31;
FUNNUM[INTERN("I",FUNNAM)]←32;
FUNNUM[INTERN("DEPART",FUNNAM)]←33;
FUNNUM[INTERN("LINK",FUNNAM)]←34;
FUNNUM[INTERN("GRASP",FUNNAM)]←35;
FUNNUM[INTERN("LISTEN",FUNNAM)]←36;
FUNNUM[INTERN("WOBBLE",FUNNAM)]←37;
FUNNUM[INTERN("WHERE",FUNNAM)]←38;
FUNNUM[INTERN("HERE",FUNNAM)]←38;
FUNNUM[INTERN("SKIPN",FUNNAM)]←39;
FUNNUM[INTERN("SKIPS",FUNNAM)]←40;
FUNNUM[INTERN("DEFINE",FUNNAM)]←41;
FUNNUM[INTERN("DUMP",FUNNAM)]←42;
FUNNUM[INTERN("SET",FUNNAM)]←43;
FUNNUM[INTERN("ED",FUNNAM)]←44;
FUNNUM[INTERN("NNUL",FUNNAM)]←45;
FUNNUM[INTERN("SEARCH",FUNNAM)]←46;
FUNNUM[INTERN("AOJ",FUNNAM)]←47;
FUNNUM[INTERN("GO",FUNNAM)]←48;
FUNNUM[INTERN("GOTO",FUNNAM)]←6;
FUNNUM[INTERN("SCREW",FUNNAM)]←49;
FUNNUM[INTERN("MOVING",FUNNAM)]←50;
FUNNUM[INTERN("ASSIGN",FUNNAM)]←51;
FUNNUM[INTERN("SOJG",FUNNAM)]←52;
IFC THROWING THENC
FUNNUM[INTERN("THROW",FUNNAM)]←53;
FUNNUM[INTERN("TOSS",FUNNAM)]←54;
IFC GRAPHICS THENC FUNNUM[INTERN("DISP",FUNNAM)]←55;ENDC
ELSEC IFC GRAPHICS THENC FUNNUM[INTERN("DISP",FUNNAM)]←53;ENDC ENDC
VECTNUM[INTERN("X",VECTNAM)]←1;
VECTNUM[INTERN("Y",VECTNAM)]←2;
VECTNUM[INTERN("Z",VECTNAM)]←3;
VECTNUM[INTERN("NIL",VECTNAM)]←0;
FREE_DATA←4;
OUTSTR("DO YOU WANT THE FILES SAVED?
");
IF INCHWL THEN FAST←FALSE;
OUTSTR("I AM CURIOUS YELLOW
");
IFC THROWING THENC OUTSTR("AND CAN THROW VERY MELLOW
"); ENDC
IFC ¬WAVE THENC
PUT_DATA(0,0,"HAND");
YES_HAND←-1;
ENDC
GO TO GET1;
GET:SIMIO(ONE_LINE);
GET1:SETFORMAT(10,2);
GGET:
IF AEF ∧ ARM_STATUS THEN BEGIN
OUTSTR(ERRORS&CRLF);
MAC_FREE←MAC←MAC_EOF←0;
FOR CHAN←CHAN STEP -1 UNTIL 2 DO RELEASE(CHAN);
END;
IF ¬MAC ∧ CHAN=1 THEN OUTSTR("*"&CRLF);
AEF←FALSE;
I←GETNAME(FALSE,S,FUNNAM);
IF CHAN>1 ∧ EQU(S,"COMMENT") THEN BEGIN
DO INPUT(CHAN,FF) UNTIL BREAK='14;
GO TO GGET END;
IF LENGTH(FUNNAM[I]) THEN EXETRUE:CASE FUNNUM[I] OF BEGIN
BEGIN "DOIT"
INTEGER J;
STRING PS,PN;
J←0;
ARM_EXECUTE←AEF←TRUE;
IF BREAK≠'15
THEN BEGIN I←GETNAME(FALSE,S,FUNNAM);
IF LENGTH(FUNNAM[I]) THEN GO TO EXETRUE;
LFILE←S;
IF BREAK="["
THEN BEGIN SL←SIMIO(RSB);
PS←SCAN(SL,DEL,BREAK);
PS←SPACES[1 FOR (3-LENGTH(PS))]&PS;
PN←SCAN(SL,DEL,BREAK);
PN←SPACES[1 FOR (3-LENGTH(PN))]&PN;
J←CVSIX(PS&PN) END END
ELSE S←LFILE;
SAY_WAIT;
IF LENGTH(FILE) THEN BEGIN
CLOSE_TRAJECTORY;
FILE←NULL;
END;
DO_IT(J,S);
GO TO GET1;
END"DOIT";
BEGIN "REQUIRE"
SIMIO(HEAD);
FILE_NAME[CHAN+1]←(S←SIMIO(ID))&'11;
IF BREAK="." THEN S←S&"."&SIMIO(ID) ELSE S←S&".HAL";
IF BREAK="[" THEN S←S&"["&SIMIO(RSB);
OPEN(CHAN+1,"DSK",0,2,0,120,BREAK,EOF);
LOOKUP(CHAN+1,S,EOF);
IF EOF≠0 THEN BEGIN OUTSTR(FILE_NAME[CHAN]&" "&LINE_NO&"FILE NOT FOUND"&CRLF);
RELEASE(CHAN+1);GO TO GET END;
CHAN←CHAN+1;
GO TO GET1;
END "REQUIRE";
BEGIN "TRANS"
INTEGER PTR;
SAFE OWN REAL ARRAY E[1:6];
SAFE OWN REAL ARRAY VT,VTT[1:4];
PTR←GETNAME(FALSE,S,TRANSNAM);
IF ¬LENGTH(TRANSNAM[PTR])
THEN BEGIN
IF FREE_DATA+2>FREE_DATA_LENGTH
THEN BEGIN OUTSTR(FILE_NAME[CHAN]&LINE_NO&"NO FREE DATA"&CRLF);GO TO GET END;
TRANSNAM[PTR]←S;
TRANSNUM[PTR]←FREE_DATA;
ARRBLT(E[1],ANEW[1],6);
FREE_DATA←FREE_DATA+2 END
ELSE ARRBLT(E[1],DATA_BASE[TRANSNUM[PTR],1],6);
IF ¬MAC ∧ CHAN=1 THEN BEGIN SIMIO(ONE_LINE);
OUTSTR(" X Y Z O A T"&CRLF);
WHILE TRUE DO BEGIN
FOR I←1 STEP 1 UNTIL 6 DO OUTSTR(CVF(E[I]));
OUTSTR(CRLF&"CHANGE?"&CRLF);
S←SIMIO(ONE_LINE);
IF ¬LENGTH(S) THEN DONE;
FOR I←1 STEP 1 UNTIL 6 DO
IF LENGTH(S) THEN BEGIN
SL←SCAN(S,DEL,IFI);
R←REALSCAN(SL,IFI);
IF IFI≠-1 THEN E[I]←R;
END;
END;
END ELSE FOR I←1 STEP 1 UNTIL 6 DO BEGIN
GETNAME(TRUE,S,VECTNAM);
E[I]←REALSCAN(S,BREAK) END;
ARRBLT(DATA_BASE[TRANSNUM[PTR],1],E[1],6);
GO TO GET1;
END"TRANS";
BEGIN "VECT"
INTEGER PTR;
PTR←GETNAME(FALSE,S,VECTNAM);
IF ¬LENGTH(VECTNAM[PTR])
THEN BEGIN
IF FREE_DATA+1>FREE_DATA_LENGTH
THEN BEGIN OUTSTR(FILE_NAME[CHAN]&LINE_NO&"NO FREE DATA"&CRLF);GO TO GET END;
VECTNAM[PTR]←S;
VECTNUM[PTR]←FREE_DATA;
FOR I←1 STEP 1 UNTIL 3 DO XV[I]←0;
FREE_DATA←FREE_DATA+1 END
ELSE ARRBLT(XV[1],DATA_BASE[VECTNUM[PTR],1],3);
XV[4]←1;
IF ¬MAC ∧ CHAN=1 THEN BEGIN
SIMIO(ONE_LINE);
WHILE TRUE DO BEGIN PVECT(NULL,XV);
OUTSTR("CHANGE ?"&CRLF);
S←SIMIO(ONE_LINE);
IF ¬LENGTH(S) THEN DONE;
FOR I←1 STEP 1 UNTIL 3 DO
IF LENGTH(S) THEN BEGIN
SL←SCAN(S,DEL,IFI);
R←REALSCAN(SL,IFI);
IF IFI≠-1 THEN XV[I]←R;
END;
END;
END ELSE FOR I←1 STEP 1 UNTIL 3 DO BEGIN
GETNAME(TRUE,S,VECTNAM);
XV[I]←REALSCAN(S,BREAK) END;
ARRBLT(DATA_BASE[VECTNUM[PTR],1],XV[1],3);
GO TO GET1;
END "VECT";
BEGIN "BEGIN"
IF FILE THEN CLOSE_TRAJECTORY ;
GETNAME(FALSE,LFILE,VECTNAM);
FILE←LFILE;
SAY_WAIT;
START_TRAJECTORY(FILE,0);
END"BEGIN";
BEGIN "PARK"
SAY_WAIT;
OPEN_ONE;
PARK_ARM;
END"PARK";
BEGIN "MOVE"
REAL DIST,DEG;
BOOLEAN GOM;
GOM←EQU(S,"GOTO");
IF READT(TT1,S,"MOVE - "&S&" TRANSFORM DOSN'T EXIST")
THEN BEGIN SIMIO(SOMETHING);
IF BREAK≠'12 ∧ BREAK≠";" THEN BEGIN
IF ¬READV(XV,S,"DX DY DZ DOSN'T EXIST") THEN GO TO GET;
GETNAME(TRUE,S,FUNNAM);
DIST←REALSCAN(S,BREAK);
IF ¬READV(YV,S,"AXIS DOSN'T EXIST")THEN GO TO GET;
GETNAME(TRUE,S,FUNNAM);
DEG←REALSCAN(S,BREAK);
SCALE(XV,XV,DIST);
REDUCE(XV);
XV[1]←XV[1]*TSX;XV[2]←XV[2]*TSY;
FOR J←1 STEP 1 UNTIL 3 DO TT1[J,4]←TT1[J,4]+XV[J];
IF DEG ∧ MAGNITUDE(YV) THEN BEGIN
FOR I←1 STEP 1 UNTIL 3 DO BEGIN
CVV(XV,TT1,I);
REVOLVE(XV,YV,DEG);
CVC(TT1,I,XV) END;
END;
END;
SAY_WAIT;
OPEN_ONE;
IF GOM THEN GO_ARM(TT1,ARM_PLAN) ELSE MOVE_ARM(TT1,ARM_PLAN);
IF ¬ARM_PLAN THEN OUTSTR(FILE_NAME[CHAN]&LINE_NO&"UNABLE TO MOVE"&CRLF)END
END"MOVE";
BEGIN"STEP"
IFC WAVE THENC
GETNAME(TRUE,S,FUNNAM);
I←INTSCAN(S,BREAK);
GETNAME(TRUE,S,FUNNAM);
R←REALSCAN(S,BREAK);
GETNAME(TRUE,S,FUNNAM);
J←INTSCAN(S,BREAK);
SAY_WAIT;
OPEN_ONE;
IF 1≤ I ≤6 THEN STEP_ARM(I,R,J) ELSE OUTSTR(FILE_NAME[CHAN]&LINE_NO&"SORRY"&CRLF);
ELSEC
OUTSTR("RUN YELLOW FOR STEP"&CRLF);
ENDC
END"STEP";
BEGIN "DRAW"
INTEGER I;
SAFE OWN REAL ARRAY PROFILE[0:5,1:4];
SAFE OWN REAL ARRAY DP[1:4];
EXTERNAL SIMPLE PROCEDURE MOVEV(REFERENCE REAL R;REAL ARRAY S);
IF ¬MAC ∧ CHAN=1 THEN BEGIN OUTSTR("POSITION,ROTATION,ANGLE
CRANK,AXIS,DEGREES
TIME,LOOP"&CRLF);
SIMIO(ONE_LINE) END;
IF ¬READV(XV,S,"NEW POSITION MISSING") THEN GO TO GET;
MOVEV(DP[1],XV);
REDUCE(DP);
DP[1]←DP[1]*TSX;
DP[2]←DP[2]*TSY;
MOVEV(PROFILE[1,1],DP);
IF ¬READV(YV,S,"ROTATION AXIS MISSING") THEN GO TO GET;
MOVEV(PROFILE[2,1],YV);
GETNAME(TRUE,S,FUNNAM);
PROFILE[3,1]←REALSCAN(S,BREAK);
IF ¬(READV(XV,S,"CRANK MISSING") ∧ READV(YV,S,"AXIS MISSING"))THEN GO TO GET;
GETNAME(TRUE,S,FUNNAM);
PROFILE[3,2]←REALSCAN(S,BREAK);
MOVEV(PROFILE[4,1],XV);
MOVEV(PROFILE[5,1],YV);
GETNAME(TRUE,S,FUNNAM);
PROFILE[0,2]←INTSCAN(S,BREAK);
GETNAME(TRUE,S,FUNNAM);
PROFILE[0,3]←INTSCAN(S,BREAK);
IF PROFILE[0,3] ∧ ¬(ABS(PROFILE[3,2])=360 ∨ ABS(PROFILE[3,1])=360)
THEN BEGIN OUTSTR(FILE_NAME[CHAN]&LINE_NO&"UNLOOPABLE
"); GO TO GET END;
SAY_WAIT;
OPEN_ONE;
DRAW_ARM(PROFILE,ARM_PLAN);
IF ARM_PLAN THEN OUTSTR(FILE_NAME[CHAN]&LINE_NO&"DRAW - SORRY"&CVOS(ARM_PLAN)&CRLF);
END"DRAW";
BEGIN"FREE"
GETNAME(TRUE,S,FUNNAM);
J←INTSCAN(S,BREAK);
FOR I←FREE_ARM[0,1]+1 STEP 1 UNTIL FREE_ARM[0,1]+J DO
BEGIN
FREE_ARM[I,1]←0;ARRBLT(FREE_ARM[I,2],FREE_ARM[I,1],5);
IF READV(XV,S,"MISSING FREE")
THEN BEGIN REDUCE(XV);
ARRBLT(FREE_ARM[I,1],XV[1],3)END;
END;
FREE_ARM[0,1]←FREE_ARM[0,1]+J;
END"FREE";
BEGIN"SPIN"
GETNAME(TRUE,S,FUNNAM);
J←INTSCAN(S,BREAK);
FOR I←FREE_ARM[0,1]+1 STEP 1 UNTIL FREE_ARM[0,1]+J DO
BEGIN
FREE_ARM[I,1]←0;ARRBLT(FREE_ARM[I,2],FREE_ARM[I,1],5);
IF READV(XV,S,"MISSING FREE")
THEN BEGIN REDUCE(XV);
ARRBLT(FREE_ARM[I,4],XV[1],3)END;
END;
FREE_ARM[0,1]←FREE_ARM[0,1]+J;
END"SPIN";
BEGIN"FORCE"
IF (READV(XV,S,"MISSING FORCE") ∧ READV(YV,S,"MISSING MOMENT"))
THEN BEGIN REDUCE(XV);
ARRBLT(FORCE_ARM[1],XV[1],3);
REDUCE(YV);
ARRBLT(FORCE_ARM[4],YV[1],3) END;
END"FORCE";
BEGIN "STOP"
IF (READV(XV,S,"MISSING FORCE") ∧ READV(YV,S,"MISSING MOMENT"))
THEN BEGIN SAY_WAIT;
OPEN_ONE;
STOP_ARM(XV,YV) END;
END"STOP";
BEGIN"OPEN_HAND"
GETNAME(TRUE,S,FUNNAM);
R←REALSCAN(S,BREAK);
SAY_WAIT;
OPEN_ONE;
OPEN_HAND(R);
END"OPEN_HAND";
BEGIN"SKIPE"
STRING SL;
SL←SIMIO(ONE_LINE);
I←CVO(SL);
SAY_WAIT;
ARM_SKIPE(I);
GO TO GET1
END"SKIPE";
BEGIN"JUMP"
STRING SC;
CODE_LINE[PTR3+1]←LINE_NO;
S←SC←SIMIO(ONE_LINE);
SCAN(SC,HEAD,J);
IF LENGTH(REF[PTR3+1]←SCAN(SC,ID,J))
THEN BEGIN SC←BREAK&SC;
I←INTSCAN(SC,J) END ELSE I←INTSCAN(S,J);
SAY_WAIT;
OPEN_ONE;
ARM_JMP(I);
GO TO GET1;
END"JUMP";
BEGIN "CLOSE_HAND"
GETNAME(TRUE,S,FUNNAM);
R←REALSCAN(S,BREAK);
SAY_WAIT;
OPEN_ONE;
CLOSE_HAND(R);
END"CLOSE_HAND";
BEGIN "CENTER"
GETNAME(TRUE,S,FUNNAM);
R←REALSCAN(S,BREAK);
SAY_WAIT;
OPEN_ONE;
CENTER_HAND(R);
END"CENTER";
BEGIN "PLACE"
SAY_WAIT;
OPEN_ONE;
PLACE_ARM;
END"PLACE";
BEGIN"CHANGE"
REAL DIST,DEG;
INTEGER TIME;
OPEN_ONE;
IF ¬READV(XV,S,"DX DY DZ DOSN'T EXIST") THEN GO TO GET;
GETNAME(TRUE,S,FUNNAM);
DIST←REALSCAN(S,BREAK);
IF ¬READV(YV,S,"AXIS DOSN'T EXIST")THEN GO TO GET;
GETNAME(TRUE,S,FUNNAM);
DEG←REALSCAN(S,BREAK);
GETNAME(TRUE,S,FUNNAM);
TIME←INTSCAN(S,BREAK);
SAY_WAIT;
CHANGE_ARM(XV,DIST,YV,DEG,TIME,ARM_PLAN);
IF ¬ARM_PLAN THEN OUTSTR(FILE_NAME[CHAN]&LINE_NO&"CAREFUL"&CRLF);
END"CHANGE";
BEGIN"DRIVE"
GETNAME(TRUE,S,FUNNAM);
I←INTSCAN(S,BREAK);
GETNAME(TRUE,S,FUNNAM);
R←REALSCAN(S,BREAK);
GETNAME(TRUE,S,FUNNAM);
J←INTSCAN(S,BREAK);
SAY_WAIT;
OPEN_ONE;
DRIVE_ARM(I,R,J,ARM_PLAN);
IF ¬ARM_PLAN THEN OUTSTR(FILE_NAME[CHAN]&LINE_NO&"SORRY"&CRLF);
END"DRIVE";
BEGIN"WAIT"
S←SIMIO(ONE_LINE);
IF LENGTH(S) THEN S←S&'15&'12;
SAY_WAIT;
WAIT_ARM(S);
GO TO GET1;
END"WAIT";
BEGIN"MERGE"
SAY_WAIT;
MERGE_ARM;
END"MERGE";
BEGIN"SAVE"
LABEL L1;
GETNAME(FALSE,S,VECTNAM);
L1: SAY_WAIT;
OPEN_ONE;
ARM_SAVE(S);
END"SAVE";
BEGIN"RESTORE"
LABEL L1;
INTEGER I;
STRING SL;
GETNAME(FALSE,S,VECTNAM);
L1: GETNAME(TRUE,SL,FUNNAM);
I←INTSCAN(SL,BREAK);
SAY_WAIT;
OPEN_ONE;
ARM_RESTORE(S,I);
END"RESTORE";
BEGIN "TOUCH"
GETNAME(TRUE,S,FUNNAM);
I←INTSCAN(S,BREAK);
SAY_WAIT;
OPEN_ONE;
SET_TOUCH(I);
END"TOUCH";
BEGIN"CONO"
IF (READV(XV,S,"APPROACH DOES NOT EXIST")
∧ READV(ZV,S,"OBJECT DOES NOT EXIST"))
THEN BEGIN
GETNAME(TRUE,S,FUNNAM);
ZV[4]←REALSCAN(S,BREAK);
GETNAME(TRUE,S,FUNNAM);
I←INTSCAN(S,BREAK);
GETNAME(TRUE,S,FUNNAM);
J←INTSCAN(S,BREAK);
SAY_WAIT;
ARM_CONO(XV,ZV,I,J);
END;
END "CONO";
BEGIN"END"
SAY_WAIT;
IF LENGTH(FILE) THEN CLOSE_TRAJECTORY;
FILE←NULL;
END"END";
IF LENGTH(FILE) THEN FLUSH(0,LAST_ARM);
BEGIN "PROCEED"
S←SIMIO(ONE_LINE);
I←INTSCAN(S,BREAK);
SAY_WAIT;
DO_PROCEED(I);
AEF←TRUE;
GO TO GET1;
END"PROCEED";
BEGIN"ASSERT"
IF ¬READT(XT,S,"ASSERT- "&S&" TRANSFORM DOSN'T EXIST") THEN GO TO GET;
ARRTRAN(LAST_TRANS,XT);
ARRTRAN(LAST_PLANNED_TRANS,XT);
ARM_SOLVE(XT,LAST_ARM,I);
ARRTRAN(LAST_PLANNED_ARM,LAST_ARM);
END"ASSERT";
BEGIN"FILE"
GETNAME(FALSE,OFILE,VECTNAM);
END"FILE";
BEGIN"I"
IF ¬MAC ∧ CHAN=1 THEN FOR I←1 STEP 1 UNTIL 6 DO OUTSTR(CVF(ARM_VECTOR[I]));
IF ¬MAC ∧ CHAN=1 THEN OUTSTR(CRLF);
END"I";
BEGIN "DEPART"
IF ¬READV(YV,S,"DEPART DOSN'T EXIST")THEN GO TO GET;
ARRTRAN(DEPART_ARM,YV);
END "DEPART";
BEGIN"LINK"
SAFE OWN REAL ARRAY T[1:4,1:4];
GETNAME(TRUE,S,FUNNAM);
I←INTSCAN(S,BREAK);
IF I<3 ∨ I>6 THEN BEGIN OUTSTR("THAT LINK IS NOT AVAILABLE"&CRLF);GO TO GET END;
ARRBLT(T[1,1],ARM_LINK[I,1,1],16);
T[1,4]←T[1,4]/TSX;
T[2,4]←T[2,4]/TSY;
PMAT(NULL,T);
END"LINK";
OUTSTR(CVF(GRASP)&CRLF);
BEGIN"LISTEN"
INTERP←FALSE;
SAY_WAIT;
IFC WAVE THENC OUTSTR("RUN HANDY FOR LISTEN"&CRLF);
ELSEC WHILE ¬INTERP DO QUEUE('600, GET_ENTRY('120,NULL,"HAND",NULL));
ENDC
END;"LISTEN"
BEGIN"WOBBLE"
GETNAME(TRUE,S,FUNNAM);
R←REALSCAN(S,BREAK);
SAY_WAIT;
OPEN_ONE;
WOBBLE_HAND(R);
END"WOBBLE";
BEGIN "POS"
SAFE OWN REAL ARRAY T[1:4,1:4];
STRING NN;
INTEGER I,PTR,IFI,J;
SAFE OWN REAL ARRAY TV[1:4];
SAFE OWN REAL ARRAY E[1:6];
LABEL JP;
REAL DEG,DIST,R;
BOOLEAN HC,GOM;
ARM_POSITION;
AEF←TRUE;
ARRBLT(T[1,1],ARM_LINK[6,1,1],16);
IF GOM←EQU(S,"HERE") THEN BEGIN
PTR←GETNAME(FALSE,NN,TRANSNAM);
SIMIO(SOMETHING);
IF BREAK≠'12 ∧ BREAK≠";" THEN BEGIN
IF ¬READV(XV,S,"DX DY DZ DOSN'T EXIST") THEN GO TO GET;
HC←0;
GETNAME(TRUE,S,FUNNAM);
DIST←REALSCAN(S,BREAK);
IF ¬READV(YV,S,"AXIS DOSN'T EXIST")THEN GO TO GET;
GETNAME(TRUE,S,FUNNAM);
DEG←REALSCAN(S,BREAK);
SCALE(XV,XV,DIST);
REDUCE(XV);
XV[1]←XV[1]*TSX;XV[2]←XV[2]*TSY;
IF DEG ∧ MAGNITUDE(YV) THEN BEGIN
IF HC THEN REVOLVE(XV,YV,-DEG);
FOR I←1 STEP 1 UNTIL 3 DO BEGIN
CVV(TV,T,I);
REVOLVE(TV,YV,-DEG);
CVC(T,I,TV) END;
END;
FOR J←1 STEP 1 UNTIL 3 DO T[J,4]←T[J,4]-XV[J];
END;
END;
SAY_WAIT;
UNSTRUCT(T,E);
IF GOM THEN BEGIN
IF ¬LENGTH(TRANSNAM[PTR])
THEN BEGIN
IF FREE_DATA+2>FREE_DATA_LENGTH
THEN BEGIN OUTSTR(FILE_NAME[CHAN]&LINE_NO&"NO FREE DATA"&CRLF);
GOM←FALSE;
GO TO JP END;
TRANSNAM[PTR]←NN;
TRANSNUM[PTR]←FREE_DATA;
FREE_DATA←FREE_DATA+2 END;END;
JP: IF ¬MAC ∧ CHAN=1 THEN BEGIN
SIMIO(ONE_LINE);
OUTSTR(" X Y Z O A T"&CRLF);
WHILE TRUE DO BEGIN
FOR I←1 STEP 1 UNTIL 6 DO OUTSTR(CVF(E[I]));
IF ¬GOM THEN BEGIN OUTSTR(CRLF);GO TO GET1 END;
OUTSTR(CRLF&"CHANGE?"&CRLF);
S←SIMIO(ONE_LINE);
IF ¬LENGTH(S) THEN DONE;
FOR I←1 STEP 1 UNTIL 6 DO
IF LENGTH(S) THEN BEGIN
SL←SCAN(S,DEL,IFI);
R←REALSCAN(SL,IFI);
IF IFI≠-1 THEN E[I]←R;
END;
END;
ARRBLT(DATA_BASE[TRANSNUM[PTR],1],E[1],6) END;
GO TO GET1;
END "POS";
BEGIN"SKIPN"
STRING SL;
SL←SIMIO(ONE_LINE);
I←CVO(SL);
SAY_WAIT;
ARM_SKIPN(I);
GO TO GET1
END"SKIPN";
BEGIN"SKIPS"
STRING SL;
SL←SIMIO(ONE_LINE);
I←CVO(SL);
SAY_WAIT;
ARM_SKIPS(I);
GO TO GET1
END"SKIPS";
BEGIN "DEFINE"
STRING ARRAY ARG[1:10];
INTEGER TMN;
I←GETNAME(FALSE,S,FUNNAM);
IF LENGTH(FUNNAM[I]) THEN OUTSTR(S&" MACRO NAME RESERVED WORD"&CRLF);
FOR TMN←1 STEP 1 UNTIL FMN DO IF EQU(S,MACRO_NAME[TMN]) THEN DONE;
IF TMN>MAX_MACRO THEN BEGIN OUTSTR("SORRY, TOO MANY MACROS
"); GO TO GET END;
IF TMN>FMN THEN MACRO_NAME[TMN]←S;
MACRO_FORMAL[TMN]←S←SIMIO(ONE_LINE);
J←0;
WHILE LENGTH(S)
DO BEGIN SCAN(S,HEAD,BREAK);
IF BREAK=";" THEN DONE;
SL←SCAN(S,ID,BREAK);
IF LENGTH(SL) THEN ARG[J←J+1]←SL END;
PUSH_FORMAT(0,0);
MACRO_DEFN[TMN]←NULL;
WHILE TRUE
DO BEGIN
IF ¬MAC ∧ CHAN=1 THEN OUTSTR("*");
S←SIMIO(ONE_LINE);
IF ¬LENGTH(S) THEN DONE;
WHILE LENGTH(S) DO BEGIN
SCAN(S,SOME,BREAK);
IF "A" ≤ BREAK ≤ "Z"
THEN BEGIN SL←SCAN(S,ID,BREAK);
FOR I←1 STEP 1 UNTIL J
DO IF EQU(SL,ARG[I])
THEN BEGIN SL←"$"&CVS(I);
DONE END;
IF BREAK=":" THEN SL←SL&":";
IF BREAK="+" ∨ BREAK="-" THEN S←BREAK&S END
ELSE
IF BREAK = ";" THEN BEGIN SL←S;S←NULL END
ELSE SL←SCAN(S,NNUMS,BREAK);
IF EQU(SL,"-") THEN S←BREAK&S;
MACRO_DEFN[TMN]←MACRO_DEFN[TMN]&SL&(IF LENGTH(S) ∧ ¬EQU(SL,"-") THEN " " ELSE NULL);
END;
MACRO_DEFN[TMN]←MACRO_DEFN[TMN]&'15&'12;
END;
POP_FORMAT;
OUTSTR((EDIT_NAME←MACRO_NAME[TMN])&(IF TMN≤FMN THEN " REDEFINED" ELSE " DEFINED")&CRLF);
IF TMN>FMN THEN FMN←TMN;
GO TO GET1;
END "DEFINE";
BEGIN "DUMP"
STRING SLPT,SA,SB,SC;
LABEL AL,PM;
INTEGER LINES,LTG;
STRING ARRAY ARG[1:10];
SIMIO(HEAD);
S←SIMIO(ID);
IF BREAK="." THEN S←S&"."&SIMIO(ID) ELSE S←S&".HAL";
IF BREAK="[" THEN S←S&"["&SIMIO(RSB);
OPEN(CHAN←CHAN+1,"DSK",0,0,3,120,BREAK,EOF);
ENTER(CHAN,S,EOF);
OUTSTR(WAIT&'15&'12);
LINES←LTG←0;
FOR I←0 STEP 1 UNTIL '77 DO
IF LENGTH(TRANSNAM[I]) THEN BEGIN
OUT(CHAN,"TRANS "&TRANSNAM[I]&" ");
ARRBLT(DIR[1],DATA_BASE[TRANSNUM[I],1],6);
FOR J←1 STEP 1 UNTIL 6 DO OUT(CHAN,CVF(DIR[J]));
OUT(CHAN,CRLF);
LINES←LINES+1;
IF LINES>50 THEN BEGIN OUT(CHAN,'14);LINES←0 END;
END;
IF LINES THEN BEGIN OUT(CHAN,CRLF&CRLF);LINES←LINES+2 END;
S←NULL;
FOR I←0 STEP 1 UNTIL '77 DO
IF LENGTH(VECTNAM[I]) THEN BEGIN
S←S&"VECT "&VECTNAM[I]&" ";
ARRBLT(DIR[1],DATA_BASE[VECTNUM[I],1],3);
FOR J←1 STEP 1 UNTIL 3 DO S←S&CVF(DIR[J]);
S←S&CRLF;
LTG←LTG+1;
IF LINES ∧ LINES+LTG>50 THEN BEGIN LINES←0; OUT(CHAN,'14) END;
IF LTG>50 THEN BEGIN OUT(CHAN,S&'14);LTG←0;S←NULL END;
END;
IF LTG THEN OUT(CHAN,S);
IF FMN THEN OUT(CHAN,'14);
LINES←LTG←0;
SLPT←NULL;
FOR I←1 STEP 1 UNTIL FMN DO BEGIN
PM: SLPT←"DEFINE "&MACRO_NAME[I]&" ";
SA←MACRO_FORMAL[I];
SB←SCAN(SA,SEMI,BREAK);
J←0;
SC←NULL;
WHILE LENGTH(SB)
DO BEGIN SCAN(SB,HEAD,BREAK);
SL←SCAN(SB,ID,BREAK);
IF LENGTH(SL) THEN SC←SC&(ARG[J←J+1]←SL)&" " END;
SLPT←SLPT&SC;
LTG←1;
IF LENGTH(SA) THEN SLPT←SLPT&SPACES[1 FOR (16-LENGTH(SC))]&SA;
SLPT←SLPT&CRLF;
S←MACRO_DEFN[I];
WHILE LENGTH(S) DO BEGIN
SA←SCAN(S,ONE_LINE,BREAK);
SB←SCAN(SA,SEMI,BREAK);
SC←NULL;
WHILE LENGTH(SB) DO BEGIN
SC←SC&SCAN(SB,DOLLAR,BREAK);
IF LENGTH(SB) THEN SC←SC&ARG[INTSCAN(SB,BREAK)];
END;
SLPT←SLPT&SC;
IF LENGTH(SA) THEN SLPT←SLPT&SPACES[1 FOR (32 - LENGTH(SC))]&SA;
SLPT←SLPT&CRLF;
AL: LTG←LTG+1;
IF LINES ∧ LINES+LTG>50 THEN BEGIN OUT(CHAN,'14);LINES←0 END;
IF LTG>50 THEN BEGIN OUT(CHAN,SLPT&'14);SLPT←NULL;LTG←0 END;
END;
IF LTG THEN BEGIN OUT(CHAN,SLPT&CRLF);
LINES←LINES+LTG+1;
LTG←0 END;
END;
RELEASE(CHAN);
CHAN←CHAN-1;
END "DUMP";
BEGIN"SET"
GETNAME(FALSE,SL,VECTNAM);
IF ¬READT(XT,S,"FRAME DOESN'T EXIST") THEN GO TO GET;
IF ¬READT(TT1,S,"WRT DOESN'T EXIST") THEN GO TO GET;
SAY_WAIT;
OPEN_ONE;
SET_ARM(SL,XT,TT1);
END"SET";
BEGIN "EDIT"
STRING SC,SO,SN,SS;
INTEGER REP;
BOOLEAN ALT;
STRING ARRAY ARG[1:10];
PROCEDURE LINED(REFERENCE STRING S;REFERENCE BOOLEAN ALT);
BEGIN STRING ST,SE;
LABEL L1,L2;
SE←S;
S←NULL;
L1: IF (REP←REP-1)≤0 THEN BEGIN
IF SC="F" THEN BEGIN ST←SE;
S←SCAN(ST,ONE_LINE,I);
WHILE LENGTH(S) DO BEGIN SCAN(S,SOME,I);
IF EQU(SS,SCAN(S,DEL,I)) THEN BEGIN S←NULL;GO TO L2 END END;
S←SE;
RETURN END;
L2: OUTSTR(SE&"?");
SC←INPUT(TTY,ONE_LINE);
IF ALT←BREAK=ALT_MODE THEN BEGIN S←SE;RETURN END;
ST←SCAN(SC,HEAD,BREAK);
IF SC="E" THEN BEGIN REP←999;
SC←NULL END
ELSE REP←INTSCAN(ST,BREAK);
END;
IF SC="F" THEN BEGIN ST←SC[2 TO ∞];IF LENGTH(ST) THEN SS←ST END;
IF SC="I" THEN BEGIN S←S&SE;OUTSTR("*");
IF ¬(SE←INCHWL)THEN BEGIN OUTSTR("A BLANK LINE TRY AGAIN"&'15&'12&"*");
SE←INCHWL END;
SE←SE&'15&'12;GO TO L1 END;
IF SC="Z" THEN BEGIN LODED(SE);
IF ¬(SE←INCHWL)THEN BEGIN OUTSTR("A BLANK LINE TRY AGAIN"&'15&'12&"*");
SE←INCHWL END;
SE←SE&'15&'12;
IF REP=1 THEN REP←0;
IF ¬REP THEN GO TO L1 END;
IF SC="T" THEN OUTSTR(SE);
IF SC≠"D" THEN S←S&SE;
END;
IF BREAK≠'15 THEN GETNAME(FALSE,EDIT_NAME,FUNNAM);
FOR I←1 STEP 1 UNTIL FMN DO IF EQU(EDIT_NAME,MACRO_NAME[I]) THEN BEGIN
SN←"DEFINE "&MACRO_NAME[I]&" "&MACRO_FORMAL[I]&"
";
INPUT(TTY,ONE_LINE);
MAC←MAC+1;
REP←0;
SS←SC←NULL;
LINED(SN,ALT);
J←0;
S←MACRO_FORMAL[I];
WHILE LENGTH(S)
DO BEGIN SCAN(S,HEAD,BREAK);
IF BREAK=";" THEN DONE;
SL←SCAN(S,ID,BREAK);
IF LENGTH(SL) THEN ARG[J←J+1]←SL END;
S←MACRO_DEFN[I];
SO←NULL;
WHILE LENGTH(S) DO BEGIN
SO←SO&SCAN(S,DOLLAR,BREAK);
IF LENGTH(S) THEN SO←SO&ARG[INTSCAN(S,BREAK)];
IF BREAK='12 THEN SO←SO&'15;
END;
WHILE LENGTH(SO) DO BEGIN LINED(S←SCAN(SO,ONE_LINE,BREAK)&"
",ALT);
IF ALT THEN BEGIN
OUTSTR('15&'12);
SO←S&SO;
S←SN;
SN←SL←NULL;
DO BEGIN SN←SN&SL;
SL←SCAN(S,ONE_LINE,BREAK)&'15&'12 END
UNTIL ¬LENGTH(S);
SO←SL&SO END
ELSE SN←SN&S END;
MACRO_SOURCE[MAC]←SN;
MAC_TOP[MAC]←MAC_FREE;
BBEG[MAC]←PTR3+1;
LLAB[MAC]←FREEL+1;
OUTSTR('15&'12);
GO TO GET1;
END;
END"EDIT";
BEGIN "NNUL" SAY_WAIT;NO_NULL END"NNUL";
BEGIN "SEARCH"
GETNAME(TRUE,S,FUNNAM);
R←REALSCAN(S,BREAK);
IF ¬READV(XV,S,"NORMAL DOSN'T EXIST") THEN GO TO GET;
IF ¬READV(YV,S,"FIRST DIRECTION DOSN'T EXIST") THEN GO TO GET;
SAY_WAIT;
OPEN_ONE;
SEARCH_ARM(R,XV,YV);
END"SEARCH";
BEGIN"AOJ"
STRING SC;
CODE_LINE[PTR3+1]←LINE_NO;
S←SC←SIMIO(ONE_LINE);
SCAN(SC,HEAD,J);
IF LENGTH(REF[PTR3+1]←SCAN(SC,ID,J))
THEN BEGIN SC←BREAK&SC;
I←INTSCAN(SC,J) END ELSE I←INTSCAN(S,J);
SAY_WAIT;
OPEN_ONE;
ARM_AOJ(I);
GO TO GET1;
END"AOJ";
BEGIN "TO"
REAL DIST,DEG;
IF READT(TT1,S,"TO - "&S&" TRANSFORM DOSN'T EXIST")
THEN BEGIN SIMIO(SOMETHING);
IF BREAK≠'12 ∧ BREAK≠";" THEN BEGIN
IF ¬READV(XV,S,"DX DY DZ DOSN'T EXIST") THEN GO TO GET;
GETNAME(TRUE,S,FUNNAM);
DIST←REALSCAN(S,BREAK);
IF ¬READV(YV,S,"AXIS DOSN'T EXIST")THEN GO TO GET;
GETNAME(TRUE,S,FUNNAM);
DEG←REALSCAN(S,BREAK);
SCALE(XV,XV,DIST);
REDUCE(XV);
XV[1]←XV[1]*TSX;XV[2]←XV[2]*TSY;
FOR J←1 STEP 1 UNTIL 3 DO TT1[J,4]←TT1[J,4]+XV[J];
IF DEG ∧ MAGNITUDE(YV) THEN BEGIN
FOR I←1 STEP 1 UNTIL 3 DO BEGIN
CVV(XV,TT1,I);
REVOLVE(XV,YV,DEG);
CVC(TT1,I,XV) END;
END;
END;
SAY_WAIT;
OPEN_ONE;
TO_ARM(TT1,ARM_PLAN);
IF ¬ARM_PLAN THEN OUTSTR(FILE_NAME[CHAN]&LINE_NO&"UNABLE TO MOVE"&CRLF)END
END"TO";
BEGIN"SCREW"
GETNAME(TRUE,S,FUNNAM);
R←REALSCAN(S,BREAK);
SAY_WAIT;
OPEN_ONE;
SCREW(R);
END"SCREW";
BEGIN"MOVING"
GETNAME(FALSE,SL,VECTNAM);
IF ¬READV(XV,S,"VELOCITY DOESN'T EXIST") THEN GO TO GET;
SAY_WAIT;
OPEN_ONE;
MOVING(SL,XV);
END"MOVING";
BEGIN"ASSIGN"
STRING S;
INTEGER VAL;
GETNAME(FALSE,S,VECTNAM);
GETNAME(TRUE,SL,VECTNAM);
VAL←INTSCAN(SL,BREAK);
SAY_WAIT;
OPEN_ONE;
ARM_ASSIGN(S,VAL);
END"ASSIGN";
BEGIN"SOJG"
INTEGER I;
STRING SL,SC;
CODE_LINE[PTR3+1]←LINE_NO;
GETNAME(FALSE,SL,VECTNAM);
S←SC←SIMIO(ONE_LINE);
SCAN(SC,HEAD,J);
IF LENGTH(REF[PTR3+1]←SCAN(SC,ID,J))
THEN BEGIN SC←BREAK&SC;
I←INTSCAN(SC,J) END ELSE I←INTSCAN(S,J);
SAY_WAIT;
OPEN_ONE;
ARM_SOJG(SL,I);
GO TO GET1;
END"SOJG";
IFC THROWING THENC
BEGIN "THROW"
INTEGER SUCCESS;
REAL FORE, AFT;
IF READT(TT1,S,"THROW - "&S&" RELEASE DOSN'T EXIST")
∧ READV(XV,S,"THROW - "&S&" VELOCITY DOSN'T EXIST")
∧ READT(XT,S,"THROW - "&S&" FINAL DOSN'T EXIST")
THEN BEGIN
GETNAME(TRUE,S,FUNNAM);
FORE ← REALSCAN(S,BREAK);
GETNAME(TRUE,S,FUNNAM);
AFT ← REALSCAN(S,BREAK);
SAY_WAIT;
OPEN_ONE;
THROW(TT1,XV,XT,FORE,AFT,SUCCESS);
IF ¬SUCCESS THEN OUTSTR(" SORRY UNABLE TO THROW"&CRLF);
END
END "THROW";
BEGIN "TOSS"
INTEGER SUCCESS;
REAL FORE, AFT, V;
SAFE REAL OWN ARRAY VEL[1:4];
IF READT(TT1,S,"TOSS - "&S&" RELEASE DOESN'T EXIST")
∧ READV(XV,S,"TOSS - "&S&" TARGET DOESN'T EXIST")
∧ READT(XT,S,"TOSS - "&S&" FINAL DOESN'T EXIST")
THEN BEGIN
GETNAME(TRUE,S,FUNNAM);
V ← REALSCAN(S,BREAK);
SAY_WAIT;
OPEN_ONE;
BALLIST(VEL,TT1,XV,V,SUCCESS);
IF ¬SUCCESS THEN OUTSTR("NO BALLISTIC SOLUTION"&CRLF)
ELSE THROW(TT1,VEL,XT,0.05,-0.05,SUCCESS);
IF ¬SUCCESS THEN OUTSTR(" SORRY, CAN'T THROW"&CRLF);
END;
END "TOSS";
ENDC
IFC GRAPHICS THENC
BEGIN "DISPLAY"
SAFE INTEGER ARRAY DISPLY[1:'3000];
LABEL TOP;
INTEGER POG;
SAFE INTEGER ARRAY FDATA[0:'2200];
STRING SIMPLE PROCEDURE SCAN_DATA(INTEGER TL,TU;STRING IND;SIMPLE PROCEDURE UP);
BEGIN INTEGER ERROR,TICK,REQD,THIS,N;
INTEGER MISSED;
BOOLEAN FIRST;
LABEL NEXT;
LOOKUP('17,DFILE&".TMP",EOF);
IF EOF THEN RETURN("FILE NOT FOUND");
REQD←CVSIX(IND);
TICK←CVSIX("TICK");
ERROR←CVSIX("ERROR");
TIME←-1;
FIRST←TRUE;
MISSED←0;
PTR←0;
BP←0;
HIT←0;
ARRYIN('17,FDATA[0],'200);
DO BEGIN "READ_LOOP"
ARRYIN('17,FDATA['200],'2000);
DO BEGIN "ITEM_LOOP"
THIS←FDATA[PTR] LAND '777777777700;
IF ¬THIS THEN RETURN(NULL);
IF THIS=TICK THEN BEGIN
MISSED←0;
TIME←TIME+1;
IF TIME<TL THEN GO TO NEXT;
IF TIME>TU THEN RETURN(NULL);
HIT←HIT+1;
IF MODULUS<2 ∨ ¬(HIT MOD MODULUS) THEN BEGIN
BUFFER[BP+1]←BUFFER[BP];
BP←BP+1;
END;
END;
IF THIS=REQD THEN BEGIN
UP;
IF FIRST THEN BEGIN
BUFFER[1]←BUFFER[BP];
ARRBLT(BUFFER[2],BUFFER[1],BP-2);
FIRST←FALSE;
END;
END;
NEXT: IF(N←FDATA[PTR] LAND '77)>'37 ∨ THIS=ERROR THEN
BEGIN MISSED←-1;
OUTSTR(CVS(TIME)&" DATA MISSED");
END;
PTR←PTR+1+(IF MISSED THEN 0 ELSE N);
END UNTIL PTR>'1777;
PTR←PTR-'2000;
ARRBLT(FDATA[0],FDATA['2000],'200);
END UNTIL EOF;
RETURN("END OF FILE");
END"SCAN_DATA";
PROCEDURE WHEN;
BEGIN
INTEGER I;
PRELOAD_WITH "OPEN_HAND","CLOSE_HAND","WAIT_ARM","PLACE_ARM","CHANGE_ARM","SET_TOUCH","STOP_ARM",
"SAVE_ARM","RESTORE_ARM","CENTER_ARM","SET_ARM","WOBBLE_ARM","SEARCH_ARM",
"AOJ_ARM","SLAVE_ARM","GO_ARM","MOVE_ARM","SCREW_ARM";
SAFE OWN STRING ARRAY FUNCTION[1:18];
IF (I←FDATA[PTR+1] LAND '77) THEN SM←SM&CVS(TIME)&" "&FUNCTION[I]&CRLF ELSE
END;
SIMPLE PROCEDURE REAL6;
BEGIN
INTEGER I;
REAL R;
I←FDATA[PTR+INDEX];
START_CODE MOVE 1,I;FMPR 1,FACTOR;MOVEM 1,R END;
BUFFER[BP]←R;
END;
SIMPLE PROCEDURE REAL1;
BEGIN
INTEGER I;
REAL R;
I←FDATA[PTR+1];
START_CODE MOVE 1,I;FMPR 1,FACTOR;MOVEM 1,R END;
BUFFER[BP]←R;
END;
SIMPLE PROCEDURE INT1;BUFFER[BP]←FDATA[PTR+1];
SIMPLE PROCEDURE INT6;
BUFFER[BP]←FDATA[PTR+INDEX];
PROCEDURE BIGHT;
BEGIN LABEL FOUND;
INTEGER BITE,T,I,J,K;
SAFE INTEGER ARRAY FEEL[1:2,1:2,1:4];
START_CODE
HRRZI 1,FDATA;
HRR 1,(1);
ADD 1,PTR;
HRLI 1,'1400;
MOVEM 1,BITE;
END;
FOR I←2 STEP -1 UNTIL 1 DO BEGIN"FINGER"
FOR J←2 STEP -1 UNTIL 1 DO
FOR K←4 STEP -1 UNTIL 1 DO
IF INDEX=I ∧ TIP=J ∧ PAD=K THEN
BEGIN"THE ONE"
T←ILDB(BITE);
START_CODE
LABEL POS,BACK;
MOVE 1,T;
TRNE 1,'2000;
JRST POS;
TRZ 1,'774000;
JRST BACK;
POS: TDO 1,NMASK;
BACK: MOVNM 1,T;
END;
GO TO FOUND;
END "THE ONE" ELSE IBP(BITE);
IBP(BITE);
END "FINGER";
FOUND: BUFFER[BP]←T;
END;
STRING SL;
SL←SIMIO(ONE_LINE);
SCAN(SL,HEAD,BREAK);
IF ¬LENGTH(DFILE←SCAN(SL,ID,BREAK)) THEN DFILE←OFILE;
OPEN('17,"DSK",'17,0,0,120,BREAK,EOF);
MODULUS←1000;
SM←"
TIME FUNCTION"&CRLF;
SETFORMAT(4,0);
S11←SCAN_DATA(0,5000,"NEXT",WHEN);
SM←SM&CVS(TIME)&" "&S11&CRLF;
OUTSTR(SM);
OUTSTR("DISPLAY, FUNCTION, FROM, TO ?"&CRLF);
SETFORMAT(0,0);
WHILE TRUE DO BEGIN
INPUT(1,HEAD);S11←INPUT(1,ID);
IF EQU(S11,"X") THEN DONE;
IF EQU(S11,"N") THEN BEGIN RELEASE('17);GO TO GET END;
IF EQU(S11,"C") THEN BEGIN DPYCLR;RELEASE('17);GO TO GET END;
IF EQU(S11,"P") THEN BEGIN
STRING FILNAM;
INTEGER FLG,CHN;
CHN ← 14;
OPEN(CHN,"DSK",8,0,3,0,0,0);
DO BEGIN
OUTSTR(13&10&"PLOT FILE = ");
FILNAM ← INCHWL;
ENTER(CHN,FILNAM&".PLT",FLG);
END UNTIL ¬FLG;
ARRYOUT(CHN,DISPLY[1],DISPLY[2]);
RELEASE(CHN);
GO TO TOP;
END;
INPUT(1,HEAD);FUNCTION←INPUT(1,ID);
IF EQU(S11,"D")THEN BEGIN
LL←INTIN(1);
UL←INTIN(1);
MODULUS←1+(UL-LL)%100;
DPYCLR;
POG←GETPOG;
DPYSET(DISPLY);
AIVECT(-511,450);
END;
IF EQU(FUNCTION,"POS")THEN BEGIN
OUTSTR("INDEX ?"&CRLF);
INDEX←INTIN(1);
FACTOR←100.0;
SCAN_DATA(LL,UL,"THETA",REAL6);
ARRGRF(BUFFER,1,BP,-300,-300,800,700,"T/"&CVS(MODULUS),
"POSITION ERROR 1/100 DEG"&CVS(INDEX)&" FROM "&CVS(LL)&" TO "&CVS(UL));
DPYOUT(POG);
GO TO TOP;
END;
IF EQU(FUNCTION,"VEL")THEN BEGIN
OUTSTR("INDEX ?"&CRLF);
INDEX←INTIN(1);
FACTOR←100.0;
SCAN_DATA(LL,UL,"VEL",REAL6);
ARRGRF(BUFFER,1,BP,-300,-300,800,700,"T/"&CVS(MODULUS),
"VELOCITY ERROR 1/100 DEG"&CVS(INDEX)&" FROM "&CVS(LL)&" TO "&CVS(UL));
DPYOUT(POG);
GO TO TOP;
END;
IF EQU(FUNCTION,"MOTOR")THEN BEGIN
OUTSTR("INDEX ?"&CRLF);
INDEX←INTIN(1);
SCAN_DATA(LL,UL,"DAC",INT6);
FOR I←1 STEP 1 UNTIL BP DO BUFFER[I]←BUFFER[I]*300/'776000;
ARRGRF(BUFFER,1,BP,-300,-300,800,700,"T/"&CVS(MODULUS),
"MOTOR "&CVS(INDEX)&" FROM "&CVS(LL)&" TO "&CVS(UL));
DPYOUT(POG);
GO TO TOP;
END;
IF EQU(FUNCTION,"DRIVE")THEN BEGIN
OUTSTR("INDEX ?"&CRLF);
INDEX←INTIN(1);
FACTOR←10.0;
SCAN_DATA(LL,UL,"BACK",REAL6);
ARRGRF(BUFFER,1,BP,-300,-300,800,700,"T/"&CVS(MODULUS),
"DRIVE "&CVS(7-INDEX)&" FROM "&CVS(LL)&" TO "&CVS(UL));
BP←HIT←0;
SCAN_DATA(LL,UL,"FORD",REAL6);
ARRGRF(BUFFER,1,BP,-300,-300,0,700,"T/"&CVS(MODULUS),
"DRIVE "&CVS(7-INDEX)&" FROM "&CVS(LL)&" TO "&CVS(UL));
DPYOUT(POG);
GO TO TOP;
END;
IF EQU(FUNCTION,"HAND")THEN BEGIN
FACTOR←100.0;
SCAN_DATA(LL,UL,"HAND",REAL1);
ARRGRF(BUFFER,1,BP,-300,-300,800,700,"T/"&CVS(MODULUS),
"HAND FROM "&CVS(LL)&" TO "&CVS(UL));
DPYOUT(POG);
GO TO TOP;
END;
IF EQU(FUNCTION,"TIME")THEN BEGIN
SCAN_DATA(LL,UL,"TICK",INT1);
ARRGRF(BUFFER,1,BP,-300,-300,800,700,"T/"&CVS(MODULUS),
"TIME FROM "&CVS(LL)&" TO "&CVS(UL));
DPYOUT(POG);
GO TO TOP;
END;
IF EQU(FUNCTION,"TOUCH")THEN BEGIN
OUTSTR("FINGER, TIP ?"&CRLF);
INDEX←INTIN(1);
TIP←INTIN(1);
FOR PAD←1 STEP 1 UNTIL 4 DO BEGIN
SCAN_DATA(LL,UL,"TOUCH",BIGHT);
ARRGRF(BUFFER,1,BP,-300,-300+(PAD-1)*180,800,150,"T/"&CVS(MODULUS),
"TOUCH FROM "&CVS(LL)&" TO "&CVS(UL));
END;
DPYOUT(POG);
GO TO TOP;
END;
OUTSTR("UNRECOGINZED COMMAND"&CRLF);
TOP:END;
END"DISPLAY";
ENDC
END ELSE
BEGIN
FOR I←1 STEP 1 UNTIL FMN DO IF EQU(S,MACRO_NAME[I])
THEN BEGIN
S←SIMIO(ONE_LINE);
SL←NULL;FOR J←1 STEP 1 UNTIL MAC DO SL←SL&" ";
IF MAC THEN OUTSTR(SL&MACRO_NAME[I]&CRLF) ELSE OUTSTR("O.K."&CRLF);
MAC←MAC+1;
MACRO_SOURCE[MAC]←MACRO_DEFN[I];
MAC_TOP[MAC]←MAC_FREE;
WHILE LENGTH(S) DO BEGIN
SCAN(S,SOME,BREAK);
IF BREAK="$"
THEN BEGIN I←INTSCAN(S,BREAK);
I←I+MAC_TOP[MAC-1];
IF I<1 ∨ I> MAC_TOP[MAC]
THEN BEGIN OUTSTR(FILE_NAME[CHAN]&LINE_NO&"MACRO PARAMETER OUT OF RANGE"&'15&'12);
GO TO GET END;
SL←MAC_PAR[I] END
ELSE SL←IF "A"≤ BREAK ≤"Z" THEN SCAN(S,ID,I) ELSE SCAN(S,NNUMS,I);
IF LENGTH(SL) THEN MAC_PAR[MAC_FREE←MAC_FREE+1]←SL END;
BBEG[MAC]←PTR3+1;
LLAB[MAC]←FREEL+1;
GO TO GET1;
END;
OUTSTR(FILE_NAME[CHAN]&LINE_NO&"UNRECOGINIZED COMMAND"&CRLF);
END;
GO TO GET;